indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'tidyr' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 317)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.97705 12.97601 12.97501 12.97405 12.97313 12.97224 12.97137 12.97051
## [9] 12.96967 12.96884 12.96801 12.96717 12.96632 12.96546 12.96458 12.96368
## [17] 12.96274 12.96177 12.96075 12.95969 12.95858 12.95740 12.95617 12.95486
## [25] 12.95348 12.95202 12.95048 12.94884 12.94711 12.94529 12.94338 12.94140
## [33] 12.93934 12.93723 12.93505 12.93283 12.93057 12.92827 12.92594 12.92358
## [41] 12.92121 12.91883 12.91645 12.91407 12.91170 12.90935 12.90702 12.90472
## [49] 12.90246 12.90024 12.89807 12.89596 12.89391 12.89193 12.89003 12.88821
## [57] 12.88648 12.88473 12.88286 12.88088 12.87879 12.87660 12.87433 12.87198
## [65] 12.86956 12.86708 12.86455 12.86198 12.85938 12.85675 12.85411 12.85147
## [73] 12.84883 12.84620 12.84360 12.84102 12.83849 12.83600 12.83358 12.83122
## [81] 12.82894 12.82675 12.82465 12.82265 12.82077 12.81901 12.81738 12.81589
## [89] 12.81455 12.81337 12.81236 12.81152 12.81029 12.80814 12.80514 12.80137
## [97] 12.79690 12.79182 12.78619 12.78010 12.77362 12.76683 12.75980 12.75261
## [105] 12.74534 12.73806 12.73085 12.72379 12.71695 12.71040 12.70423 12.69851
## [113] 12.69332 12.68873 12.68482 12.68166 12.67934 12.67793 12.67750 12.67813
## [121] 12.67976 12.68222 12.68547 12.68943 12.69406 12.69928 12.70504 12.71129
## [129] 12.71795 12.72498 12.73231 12.73988 12.74763 12.75551 12.76345 12.77139
## [137] 12.77928 12.78705 12.79465 12.80201 12.80908 12.81579 12.82424 12.83616
## [145] 12.85099 12.86819 12.88719 12.90743 12.92835 12.94939 12.97000 12.98961
## [153] 13.00766 13.02361 13.03687 13.04691 13.05565 13.06538 13.07602 13.08749
## [161] 13.09974 13.11270 13.12629 13.14044 13.15509 13.17017 13.18560 13.20133
## [169] 13.21727 13.23337 13.24955 13.26574 13.28187 13.29788 13.31369 13.32924
## [177] 13.34445 13.35927 13.37361 13.38741 13.40060 13.41312 13.42489 13.43584
## [185] 13.44590 13.45501 13.46310 13.47009 13.47592 13.48052 13.48382 13.48575
## [193] 13.48624 13.48522 13.48263 13.47839 13.47258 13.46540 13.45693 13.44729
## [201] 13.43655 13.42483 13.41222 13.39881 13.38471 13.37001 13.35481 13.33921
## [209] 13.32330 13.30718 13.29094 13.27470 13.25618 13.23349 13.20724 13.17806
## [217] 13.14656 13.11337 13.07910 13.04437 13.00981 12.97603 12.94366 12.91330
## [225] 12.88559 12.86115 12.83661 12.80850 12.77727 12.74334 12.70716 12.66916
## [233] 12.62978 12.58946 12.54864 12.50776 12.46724 12.42754 12.38909 12.35232
## [241] 12.31768 12.28560 12.25652 12.23088 12.20911 12.18979 12.17116 12.15321
## [249] 12.13591 12.11923 12.10315 12.08765 12.07271 12.05830 12.04439 12.03096
## [257] 12.01800 12.00546 11.99334 11.98167 11.97052 11.95989 11.94977 11.94019
## [265] 11.93113 11.92261 11.91462 11.90717 11.90027 11.89391 11.88810 11.88284
## [273] 11.87814 11.87400 11.87043 11.86736 11.86474 11.86259 11.86092 11.85976
## [281] 11.85912 11.85901 11.85946 11.86048 11.86209 11.86430 11.86713 11.87060
## [289] 11.87472 11.87946 11.88478 11.89066 11.89711 11.90412 11.91171 11.91986
## [297] 11.92857 11.93785 11.94770 11.95810 11.96908 11.98061 11.99270 12.00535
## [305] 12.01857 12.03234 12.04667 12.06156 12.07700 12.09300 12.10956 12.12667
## [313] 12.14433 12.16255 12.18132 12.20064 12.22051#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 317)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.60858 12.60485 12.60122 12.59770 12.59427 12.59094 12.58770 12.58456
## [9] 12.58149 12.57850 12.57559 12.57276 12.56999 12.56729 12.56464 12.56206
## [17] 12.55952 12.55704 12.55460 12.55220 12.54984 12.54751 12.54522 12.54294
## [25] 12.54070 12.53846 12.53625 12.53404 12.53184 12.52964 12.52743 12.52523
## [33] 12.52304 12.52087 12.51871 12.51658 12.51449 12.51242 12.51041 12.50843
## [41] 12.50652 12.50466 12.50286 12.50114 12.49949 12.49793 12.49645 12.49506
## [49] 12.49377 12.49258 12.49150 12.49054 12.48970 12.48898 12.48840 12.48795
## [57] 12.48764 12.48741 12.48719 12.48700 12.48683 12.48669 12.48658 12.48651
## [65] 12.48649 12.48652 12.48660 12.48675 12.48695 12.48723 12.48759 12.48803
## [73] 12.48855 12.48916 12.48987 12.49068 12.49159 12.49262 12.49376 12.49503
## [81] 12.49642 12.49794 12.49960 12.50141 12.50336 12.50546 12.50772 12.51014
## [89] 12.51273 12.51549 12.51843 12.52155 12.52466 12.52757 12.53031 12.53289
## [97] 12.53534 12.53767 12.53991 12.54207 12.54418 12.54625 12.54831 12.55037
## [105] 12.55246 12.55460 12.55680 12.55909 12.56148 12.56401 12.56667 12.56951
## [113] 12.57253 12.57576 12.57922 12.58292 12.58690 12.59116 12.59573 12.60062
## [121] 12.60585 12.61137 12.61717 12.62323 12.62952 12.63604 12.64276 12.64965
## [129] 12.65671 12.66391 12.67122 12.67864 12.68614 12.69370 12.70130 12.70893
## [137] 12.71656 12.72417 12.73175 12.73926 12.74863 12.76141 12.77706 12.79505
## [145] 12.81485 12.83592 12.85773 12.87975 12.90143 12.92225 12.94167 12.95916
## [153] 12.97418 12.98620 12.99861 13.01477 13.03413 13.05614 13.08023 13.10585
## [161] 13.13243 13.15943 13.18629 13.21244 13.23732 13.26039 13.28109 13.29885
## [169] 13.31311 13.32333 13.33163 13.34044 13.34967 13.35922 13.36900 13.37890
## [177] 13.38884 13.39871 13.40842 13.41787 13.42696 13.43560 13.44370 13.45115
## [185] 13.45786 13.46372 13.46866 13.47256 13.47533 13.47688 13.47711 13.47592
## [193] 13.47321 13.46889 13.46286 13.45503 13.44447 13.43058 13.41375 13.39437
## [201] 13.37281 13.34946 13.32471 13.29894 13.27254 13.24588 13.21936 13.19335
## [209] 13.16825 13.14443 13.12228 13.10219 13.08055 13.05403 13.02340 12.98946
## [217] 12.95297 12.91473 12.87551 12.83610 12.79727 12.75982 12.72452 12.69215
## [225] 12.66350 12.63935 12.61645 12.59128 12.56412 12.53530 12.50512 12.47390
## [233] 12.44194 12.40955 12.37705 12.34474 12.31294 12.28196 12.25210 12.22367
## [241] 12.19700 12.17238 12.15012 12.13055 12.11396 12.10000 12.08795 12.07757
## [249] 12.06865 12.06093 12.05419 12.04820 12.04272 12.03752 12.03237 12.02703
## [257] 12.02127 12.01486 12.00756 12.00012 11.99338 11.98732 11.98191 11.97710
## [265] 11.97287 11.96917 11.96597 11.96325 11.96095 11.95906 11.95752 11.95632
## [273] 11.95541 11.95475 11.95432 11.95425 11.95468 11.95561 11.95704 11.95895
## [281] 11.96134 11.96420 11.96751 11.97128 11.97550 11.98015 11.98523 11.99074
## [289] 11.99665 12.00299 12.00974 12.01691 12.02451 12.03253 12.04097 12.04984
## [297] 12.05913 12.06885 12.07898 12.08955 12.10054 12.11195 12.12379 12.13606
## [305] 12.14875 12.16187 12.17542 12.18939 12.20380 12.21863 12.23389 12.24958
## [313] 12.26570 12.28224 12.29922 12.31663 12.33447#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 317)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.95523 11.95353 11.95192 11.95038 11.94891 11.94750 11.94615 11.94484
## [9] 11.94358 11.94235 11.94115 11.93996 11.93879 11.93763 11.93646 11.93529
## [17] 11.93410 11.93288 11.93164 11.93035 11.92903 11.92765 11.92621 11.92471
## [25] 11.92313 11.92148 11.91973 11.91789 11.91595 11.91390 11.91174 11.90945
## [33] 11.90703 11.90448 11.90178 11.89892 11.89592 11.89276 11.88947 11.88606
## [41] 11.88254 11.87893 11.87524 11.87149 11.86768 11.86384 11.85998 11.85610
## [49] 11.85223 11.84838 11.84456 11.84079 11.83707 11.83343 11.82988 11.82643
## [57] 11.82309 11.81988 11.81682 11.81391 11.81118 11.80862 11.80627 11.80413
## [65] 11.80183 11.79901 11.79573 11.79200 11.78786 11.78336 11.77853 11.77340
## [73] 11.76801 11.76240 11.75660 11.75065 11.74459 11.73845 11.73227 11.72608
## [81] 11.71992 11.71383 11.70785 11.70200 11.69633 11.69087 11.68567 11.68074
## [89] 11.67614 11.67189 11.66804 11.66461 11.66166 11.65920 11.65728 11.65594
## [97] 11.65521 11.65513 11.65572 11.65660 11.65734 11.65798 11.65855 11.65908
## [105] 11.65961 11.66018 11.66080 11.66153 11.66238 11.66340 11.66461 11.66605
## [113] 11.66776 11.66976 11.67209 11.67479 11.67788 11.68139 11.68537 11.68984
## [121] 11.69485 11.70041 11.70657 11.71335 11.72079 11.72893 11.73903 11.75210
## [129] 11.76775 11.78564 11.80538 11.82662 11.84898 11.87209 11.89559 11.91911
## [137] 11.94228 11.96473 11.98610 12.00601 12.02411 12.04001 12.05721 12.07895
## [145] 12.10451 12.13318 12.16424 12.19698 12.23067 12.26461 12.29806 12.33033
## [153] 12.36068 12.38841 12.41280 12.43313 12.45163 12.47099 12.49112 12.51195
## [161] 12.53341 12.55542 12.57790 12.60079 12.62400 12.64746 12.67109 12.69483
## [169] 12.71859 12.74230 12.76589 12.78928 12.81239 12.83516 12.85750 12.87934
## [177] 12.90061 12.92123 12.94112 12.96022 12.97844 12.99571 13.01196 13.02711
## [185] 13.04108 13.05381 13.06521 13.07522 13.08375 13.09073 13.09609 13.09975
## [193] 13.10163 13.10167 13.09979 13.09590 13.08971 13.08110 13.07029 13.05750
## [201] 13.04297 13.02691 13.00956 12.99112 12.97183 12.95191 12.93158 12.91107
## [209] 12.89061 12.87040 12.85069 12.83169 12.80954 12.78091 12.74683 12.70833
## [217] 12.66642 12.62215 12.57653 12.53060 12.48537 12.44188 12.40115 12.36420
## [225] 12.33208 12.30579 12.28144 12.25463 12.22570 12.19497 12.16276 12.12939
## [233] 12.09519 12.06048 12.02558 11.99081 11.95650 11.92297 11.89055 11.85955
## [241] 11.83030 11.80312 11.77834 11.75627 11.73725 11.72107 11.70712 11.69509
## [249] 11.68468 11.67557 11.66746 11.66004 11.65300 11.64603 11.63882 11.63107
## [257] 11.62247 11.61271 11.60147 11.58966 11.57835 11.56751 11.55713 11.54717
## [265] 11.53763 11.52847 11.51967 11.51120 11.50306 11.49521 11.48762 11.48029
## [273] 11.47318 11.46627 11.45953 11.45305 11.44690 11.44108 11.43559 11.43045
## [281] 11.42565 11.42120 11.41708 11.41332 11.40991 11.40685 11.40415 11.40181
## [289] 11.39983 11.39818 11.39685 11.39583 11.39513 11.39474 11.39466 11.39489
## [297] 11.39543 11.39629 11.39745 11.39893 11.40072 11.40281 11.40522 11.40793
## [305] 11.41095 11.41428 11.41792 11.42186 11.42611 11.43066 11.43552 11.44069
## [313] 11.44616 11.45194 11.45802 11.46440 11.47108#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")